home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok56 / intas / intoas-txt / intas.mod next >
Text File  |  1993-11-04  |  9KB  |  347 lines
  1. (*********************************************************************
  2.  *
  3.  *  :Program.        IntAS
  4.  *  :Author.        Hans Schafft
  5.  *  :Address.        Landfriedstraße 1A - Hinterhaus
  6.  *  :Address.        6900 Heidelberg
  7.  *  :Phone.        06221 - 22416
  8.  *  :Version.        1.0
  9.  *  :Date.        1991
  10.  *  :Copyright.        PD
  11.  *  :Language.        Modula-II
  12.  *  :Translator.    M2Amiga 4.0
  13.  *  :Contents.
  14.  *
  15.  *********************************************************************)
  16. (***************************************************************)
  17. (* Das Modul wandelt INLINE - Code von M2Amiga 1.x in ASSEMBLE *)
  18. (* Anweisungen für M2Amiga 4.0. Außerdem korrigiert es die IM- *)
  19. (* PORT - Anweisungen und ändert die Anweisung '(*$E-*)' um in *)
  20. (* '(* $EntryExitCode := FALSE *)'     Beginn Juni 1991        *)
  21. (***************************************************************)
  22.  
  23. MODULE INtAS;
  24.  
  25. FROM Terminal    IMPORT    ReadLn;
  26. FROM Arguments    IMPORT    GetArg, NumArgs;
  27. FROM InOut    IMPORT    done,termCh,SetInput,SetOutput,CloseInput,
  28.             WriteString,Write,Read,WriteLn,
  29.             CloseOutput,ReadString;
  30. FROM Arts    IMPORT    Assert,Terminate;
  31. FROM SYSTEM    IMPORT    ADR;
  32. FROM ASCII    IMPORT    eof,eol,ht;
  33. FROM String    IMPORT    Length,Copy,Occurs,Concat,Compare,first,last,
  34.             Delete,Insert,CopyPart;
  35.  
  36.  
  37. CONST SchluesselWortGroesse = 5;
  38.  
  39.  
  40. VAR  leer,name,strIn,rest : ARRAY [0..199] OF CHAR;
  41.      lenIn,len         : INTEGER;
  42.      mindestensZweitesWort : BOOLEAN;
  43.  
  44.  
  45. (****************************************************************************)
  46. (* LiesZeileEin in strIn, und gibt TRUE zurück, wenn LetzeZeile sonst FALSE *)
  47. (****************************************************************************)
  48. PROCEDURE ReadLine() : BOOLEAN;
  49. BEGIN
  50.  
  51.   (* strIn initialisieren *)
  52.   FOR lenIn := 0 TO 199 DO
  53.     strIn[lenIn] := 0C;
  54.   END;
  55.   lenIn := 0;
  56.  
  57.   REPEAT
  58.     Read(strIn[lenIn]);
  59.     INC(lenIn);
  60.     Assert(lenIn < 199,ADR("Zu lange Zeile !"));
  61.   UNTIL (strIn[lenIn - 1] = eol) OR (strIn[lenIn - 1] = eof);
  62.  
  63.   IF (strIn[lenIn - 1] = eof) THEN
  64.     RETURN TRUE;
  65.   ELSE
  66.     RETURN FALSE;
  67.   END;
  68.  
  69. END ReadLine;
  70.  
  71.  
  72. (*****************************************************************************)
  73. (* ersetzt in einem String 'str' durch 'ersatz' und gibt das erste Vorkommen *)
  74. (* von 'str' zurück; kam 'str' nicht vor,wird 'last' zurückgegeben           *)
  75. (*****************************************************************************)
  76. PROCEDURE strInModifizieren(str,ersatz : ARRAY OF CHAR) : INTEGER;
  77.  
  78. VAR occ,strLen : INTEGER;
  79.  
  80. BEGIN
  81.   strLen := Length(str);
  82.  
  83.   occ := Occurs(strIn,0,str,TRUE);
  84.  
  85.   (* Ändere ggf. strIn und lenIn *)
  86.  
  87.   IF occ # last THEN
  88.     CopyPart(rest,strIn,0,occ);
  89.     Concat(rest,ersatz);
  90.     CopyPart(name,strIn,occ+strLen,lenIn-occ-strLen);
  91.     Concat(rest,name);
  92.     Copy(strIn,rest);
  93.   END;
  94.  
  95.   lenIn := Length(strIn);
  96.   RETURN occ;
  97.  
  98. END strInModifizieren;
  99.  
  100.  
  101. (************************************************************)
  102. (* Übersetzt die einzelnen Worte eines übergebenen Strings  *)
  103. (************************************************************)
  104. PROCEDURE UebersetzeUndGibAusWort(wort : ARRAY OF CHAR; laenge : INTEGER);
  105.  
  106. VAR a : INTEGER;
  107.  
  108. BEGIN
  109.   IF mindestensZweitesWort THEN
  110.     WriteString(", ");
  111.   END;
  112.  
  113.   IF wort[laenge-1] = "H" THEN
  114.     Write("$");
  115.   ELSIF wort[laenge-1] = "B" THEN
  116.     Write("@");
  117.   ELSIF wort[laenge-1] = "L" THEN
  118.     Write("%");
  119.   ELSE    (* DezimalZahl *)
  120.     WriteString(wort);
  121.   END;
  122.  
  123.   FOR a := 1 TO laenge-2 DO
  124.     Write(wort[a]);
  125.   END;
  126.  
  127.   mindestensZweitesWort := TRUE;
  128.  
  129. END UebersetzeUndGibAusWort;
  130.  
  131.  
  132. (************************************************************)
  133. (* bereitet die übersetztung einer Zeile vor  *)
  134. (************************************************************)
  135. PROCEDURE UebersetzeZeile(VAR str : ARRAY OF CHAR) : BOOLEAN;
  136.  
  137. VAR len,a,b : INTEGER;
  138.     ende : BOOLEAN;
  139.     wort : ARRAY [0..7] OF CHAR;
  140.  
  141. BEGIN
  142.   len := Length(str);
  143.  
  144.   (* -----------------------------------------------  *)
  145.   (* Lies Block bis Komma oder abschließender Klammer *)
  146.   (* -----------------------------------------------  *)
  147.  
  148.   a := 0;
  149.   WHILE a < len DO
  150.  
  151.     ende := FALSE;
  152.  
  153.     (* Leerzeichen und Tabs überlesen *)
  154.     WHILE (str[a] < "0") AND (a < len) DO
  155.       IF str[a] = ")" THEN
  156.         ende := TRUE;
  157.       END;
  158.       INC(a);
  159.     END;
  160.  
  161.     IF NOT ende THEN
  162.  
  163.       (* Array 'wort' säubern  *)
  164.  
  165.       FOR b := 0 TO 7 DO
  166.         wort[b] := 0C;
  167.       END;
  168.  
  169.       (* alles was ziffer oder Buchstabe ist nach wort einlesen *)
  170.       (* bis ein Komma, leerzeichen, KlammerZu o.ä. erscheint   *)
  171.  
  172.       b := 0;
  173.       WHILE (str[a] >= "0") AND (a < len) DO
  174.         wort[b] := str[a];
  175.         INC(a);INC(b);
  176.       END;
  177.  
  178.       IF b > 1 THEN
  179.         UebersetzeUndGibAusWort(wort,b);
  180.       END;
  181.  
  182.     ELSE
  183.       WriteString("\n  END);");
  184.       RETURN TRUE;
  185.     END;
  186.  
  187.  
  188.   END; (* WHILE a < len DO *)
  189.  
  190.   RETURN ende;
  191.  
  192. END UebersetzeZeile;
  193.  
  194.  
  195. (***********************************************************)
  196. (* wandelt wortweise organisierte Daten ins neu Format um  *)
  197. (***********************************************************)
  198. PROCEDURE WandleDaten(x : INTEGER);
  199. VAR ok,fertig : BOOLEAN;
  200. BEGIN
  201.   (* strIn bis position x ausgeben *)
  202.   FOR len := 0 TO x-1 DO
  203.     Write(strIn[len]);
  204.   END;
  205.   Write(" ");
  206.   Delete(strIn,0,x); (* Schon geschriebenes aus strIn löschen *)
  207.   lenIn := Length(strIn);
  208.  
  209.   (* ---------------------------------------------------------  *)
  210.   (* Daten, die ab strIn[0] stehen wandeln und direkt schreiben *)
  211.   (* Lies Block bis Komma oder abschließender Klammer *)
  212.   (* -----------------------------------------------  *)
  213.  
  214.   mindestensZweitesWort := FALSE;
  215.  
  216.   fertig := UebersetzeZeile(strIn);WriteLn;
  217.  
  218.   WHILE NOT fertig DO
  219.     Write(ht);
  220.     ok := ReadLine();
  221.     fertig := UebersetzeZeile(strIn);
  222.     WriteLn;
  223.   END;
  224.  
  225.   FOR lenIn := 0 TO 199 DO
  226.     strIn[lenIn] := 0C;
  227.   END;
  228.  
  229. END WandleDaten;
  230.  
  231. (*******************************)
  232. (* eigentliches Hauptprogramm  *)
  233. (*******************************)
  234. PROCEDURE Umwandeln;
  235. VAR letzteZeile,wandle    : BOOLEAN;
  236.     occ,x : INTEGER;
  237. BEGIN
  238.  
  239.   REPEAT
  240.  
  241.     (* LiesZeileEin in strIn *)
  242.     letzteZeile :=  ReadLine();
  243.  
  244.     (* wenn Zeile kleiner als SchluesselWortGroesse -> sofort wieder ausgeben *)
  245.     IF lenIn > SchluesselWortGroesse THEN
  246.  
  247.       (* Untersuche auf das Schlüsselwort (*$E-*) + ändere*)
  248.       occ := strInModifizieren("(*$E-*)"," (*$EntryExitCode := FALSE *)");
  249.  
  250.       (* Untersuche auf das Schlüsselwort (*$C+*) + lösche *)
  251.       occ := strInModifizieren("(*$C+*)"," ");
  252.  
  253.       (* Untersuche auf das Schlüsselwort Str *)
  254.       occ := strInModifizieren("Str","String");
  255.  
  256.       (* Untersuche auf das Schlüsselwort Strings *)
  257.       occ := strInModifizieren("Strings","String");
  258.  
  259.       (* Untersuche auf das Schlüsselwort INLINE *)
  260.       occ := strInModifizieren("INLINE","ASSEMBLE");
  261.  
  262.       (* wurde 'INLINE' ersetzt ? wenn ja -> nächstes Zeichen holen *)
  263.       IF occ # last THEN
  264.  
  265.         INC(occ,7);
  266.         wandle := FALSE;
  267.  
  268.         WHILE occ <= lenIn DO         (* VORAUSSETZUNG:  INLINE und die *)
  269.           IF strIn[occ] = "(" THEN    (* KlammerAuf stehen in einer Zeile ! *)
  270.             wandle := TRUE;        (* ---------------------------------- *)
  271.             x := occ + 1;
  272.           END;
  273.           INC(occ);
  274.         END;
  275.  
  276.         (* --------------------------------------------------------------  *)
  277.         (* wenn '(' -> CodeLesen-Umwandeln-Ausgeben bis ')' gefunden wird, *)
  278.         (* dann dafür 'END);' einsetzen *)
  279.         (* ---------------------------  *)
  280.  
  281.         IF wandle THEN
  282.           Insert(strIn,x,"DC.W  ");
  283.           WandleDaten(x + 5); (* ab da könnten Daten sein *)
  284.         END;
  285.  
  286.       END;
  287.  
  288.     END;
  289.  
  290.     WriteString(strIn);
  291.  
  292.   UNTIL letzteZeile;
  293.  
  294. END Umwandeln;
  295.  
  296. (***************************************************************)
  297. PROCEDURE OeffneDateien;
  298. VAR name2 : ARRAY [0..199] OF CHAR;
  299. BEGIN
  300.   Copy(name2,name);
  301.   Concat(name2,"-4.0");
  302.   WriteString("\n\tErzeugt wird die Datei ");
  303.   WriteString(name2);WriteLn;WriteLn;
  304.   SetInput(name);
  305.   Assert(done,ADR("LeseDatei nicht zu öffnen"));
  306.   SetOutput(name2);
  307.   Assert(done,ADR("AusgabeDatei nicht zu öffnen"));
  308. END OeffneDateien;
  309.  
  310. (***************************************************************)
  311. PROCEDURE GebrauchsAnleitung;
  312. BEGIN
  313.   WriteString("\n\tusage : INtAS [Datei]   (c) H.Schafft '91\n");
  314.   WriteString("\n\terzeugt wird die Datei '[datei]-4.0'\n\n");
  315.   Terminate;
  316. END GebrauchsAnleitung;
  317.  
  318. (***************************************************************)
  319. PROCEDURE LiesArgumente;
  320. VAR len : INTEGER;
  321. BEGIN
  322.   IF NumArgs() = 1 THEN
  323.     GetArg(1,name,len);
  324.     IF name[0] = "?" THEN
  325.       GebrauchsAnleitung;
  326.     ELSE
  327.       OeffneDateien;
  328.     END;
  329.   ELSE
  330.     WriteString("\n\tName der Datei : ");ReadLn(name,len);
  331.     OeffneDateien;
  332.   END;
  333. END LiesArgumente;
  334.  
  335. (***************************************************************)
  336. (* MAIN *)
  337. (***************************************************************)
  338. BEGIN
  339.   LiesArgumente;
  340.   Umwandeln;
  341.  
  342.   CLOSE
  343.     CloseOutput;
  344.     CloseInput;
  345.  
  346. END INtAS.
  347.